unit CPGDIFileExport;

interface

uses Classes, Controls, Windows, Graphics, CPBase, CPPlotExport;

type
  { This is the base class for exporting to Windows Bitmaps or Enhanced Meta
    Files.
    @seealso TCPBitmapExport
    @seealso TCPEnhancedMetaFileExport }
  TCPGDIFileExport = class(TCPPlotExport)
  private
  protected
    FGraphic: TGraphic;
    FFileCanvas: TCanvas;
    FCopyToClipboard: Boolean;
    Region: HRGN;
    procedure CreateDrawing; virtual; abstract;
    function ToDots(Inches: Single): Integer;
    procedure SetBrushColor(const Value: TColor); override;
    procedure SetPenColor(const Value: TColor); override;
    procedure SetPenWidth(const Value: TCPFloat); override;
  public
    procedure AfterConstruction; override;
    function TextExtent(const Text: string): TCPVector; override;
    procedure BeginDraw; override;
    procedure EndDraw; override;
    procedure MoveTo(X, Y: TCPFloat); override;
    procedure LineTo(X, Y: TCPFloat); override;
    procedure HorizLine(Y: TCPFloat); override;
    procedure VertLine(X: TCPFloat); override;
    procedure Ellipse(const Bounds: TCPBounds); override;
    procedure Rectangle(const Bounds: TCPBounds); override;
    procedure FrameRect(const Bounds: TCPBounds); override;
    procedure FillRect(const Bounds: TCPBounds); override;
    procedure TextOut(X, Y: TCPFloat; const Text: string); override;
    property CopyToClipboard: Boolean read FCopyToClipboard
      write FCopyToClipboard;
  end;

  TCPBitmapExport = class(TCPGDIFileExport)
  protected
    procedure CreateDrawing; override;
  public
    procedure AfterConstruction; override;
  end;

  TCPEnhancedMetaFileExport = class(TCPGDIFileExport)
  protected
    procedure CreateDrawing; override;
  public
    procedure AfterConstruction; override;
  end;

implementation

uses CPPlotCanvas, Clipbrd;

{ TCPGDIFileExport }

procedure TCPGDIFileExport.AfterConstruction;
begin
  inherited;
  FCopyToClipboard := false;
end;

procedure TCPGDIFileExport.BeginDraw;
var
  R: TRect;
begin
  CreateDrawing;
  FFileCanvas.Brush.Color := Color;
  R := Rect(0, 0, Round(FBounds.Width), Round(FBounds.Height));
  Region := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
  SelectClipRgn(FFileCanvas.Handle, Region);
  FFileCanvas.FillRect(R);
  FFileCanvas.Font := FFont;
  FFileCanvas.Font.Height := Round(FFontHeight);
end;

procedure TCPGDIFileExport.Ellipse(const Bounds: TCPBounds);
begin
  inherited;
  FFileCanvas.Ellipse(Rect(Round(Bounds.Left),
    Round(Bounds.Top),
    Round(Bounds.Width + Bounds.Left),
    Round(Bounds.Height + Bounds.Top)));
end;

procedure TCPGDIFileExport.EndDraw;
begin
  inherited;
  SelectClipRgn(FFileCanvas.Handle, 0);
  DeleteObject(Region);
  if (FGraphic is TMetafile) then
    FFileCanvas.Free;
  if (FCopyToClipboard) then
    Clipboard.Assign(FGraphic)
  else
    FGraphic.SaveToFile(FFileName);
  FGraphic.Free;
end;

procedure TCPGDIFileExport.FillRect(const Bounds: TCPBounds);
begin
  FFileCanvas.FillRect(Rect(Round(Bounds.Left),
    Round(Bounds.Top),
    Round(Bounds.Width + Bounds.Left),
    Round(Bounds.Height + Bounds.Top)));
end;

procedure TCPGDIFileExport.FrameRect(const Bounds: TCPBounds);
begin
  FFileCanvas.FrameRect(Rect(Round(Bounds.Left),
    Round(Bounds.Top),
    Round(Bounds.Width + Bounds.Left),
    Round(Bounds.Height + Bounds.Top)));
end;

procedure TCPGDIFileExport.HorizLine(Y: TCPFloat);
begin
  MoveTo(0, Y);
  LineTo(FBounds.Width, Y);
end;

procedure TCPGDIFileExport.LineTo(X, Y: TCPFloat);
begin
  FFileCanvas.LineTo(Round(X), Round(Y));
  inherited;
end;

procedure TCPGDIFileExport.MoveTo(X, Y: TCPFloat);
begin
  inherited;
  FFileCanvas.MoveTo(Round(X), Round(Y));
end;

procedure TCPGDIFileExport.Rectangle(const Bounds: TCPBounds);
begin
  FFileCanvas.Rectangle(Rect(Round(Bounds.Left),
    Round(Bounds.Top),
    Round(Bounds.Width + Bounds.Left),
    Round(Bounds.Height + Bounds.Top)));
end;

procedure TCPGDIFileExport.SetBrushColor(const Value: TColor);
begin
  inherited;
  FFileCanvas.Brush.Color := FBrushColor;
end;

procedure TCPGDIFileExport.SetPenColor(const Value: TColor);
begin
  inherited;
  FFileCanvas.Pen.Color := FPenColor;
end;

procedure TCPGDIFileExport.SetPenWidth(const Value: TCPFloat);
begin
  inherited;
  FFileCanvas.Pen.Width := FPenDiscreteUnitWidth;
end;

function TCPGDIFileExport.TextExtent(const Text: string): TCPVector;
var
  Size: TSize;
begin
  Size := FFileCanvas.TextExtent(Text);
  Result := CPToVector(Size.cx, Size.cy);
end;

procedure TCPGDIFileExport.TextOut(X, Y: TCPFloat; const Text: string);
begin
  SetBkMode(FFileCanvas.Handle, TRANSPARENT);
  FFileCanvas.Font.Color := FPenColor;
  FFileCanvas.TextOut(Round(X), Round(Y), Text);
end;

function TCPGDIFileExport.ToDots(Inches: Single): Integer;
begin
  Result := Round(Inches * FUnitsPerInch);
end;

procedure TCPGDIFileExport.VertLine(X: TCPFloat);
begin
  MoveTo(X, 0);
  LineTo(X, FBounds.Height);
end;

{ TCPEnhancedMetaFileExport }

procedure TCPEnhancedMetaFileExport.AfterConstruction;
begin
  inherited;
  FFileExtension := 'emf';
end;

procedure TCPEnhancedMetaFileExport.CreateDrawing;
begin
  FGraphic := TMetafile.Create;
  FGraphic.Width := Round(FBounds.Width);
  FGraphic.Height := Round(FBounds.Height);
  FFileCanvas := TMetaFileCanvas.CreateWithComment(
    TMetafile(FGraphic), 0, 'Crispy Plotter', '');
end;

{ TCPBitmapExport }

procedure TCPBitmapExport.AfterConstruction;
begin
  inherited;
  FFileExtension := 'bmp';
end;

procedure TCPBitmapExport.CreateDrawing;
begin
  FGraphic := TBitmap.Create;
  FGraphic.Width := Round(FBounds.Width);
  FGraphic.Height := Round(FBounds.Height);
  TBitmap(FGraphic).PixelFormat := pf24bit;
  FFileCanvas := TBitmap(FGraphic).Canvas;
end;

end.
